www.gusucode.com > 茶都拼客网全功能版 8 > 茶都拼客网全功能版 8.8源码程序/teasdxmccom/茶都拼客网V8.8（全功能，无限制，完全开源）/Ku_Inc/Ku_function.asp

    <%
Rem Ku_Sys 信息条的显示
Function Ku_ShowInfo(s_num,nums,Linenum,S_info,Show_date)
response.write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""1"" cellspacing=""1"">"& vbCrLf
Select case s_num
	case 1 '热门
InfoSql="select top "&nums&" * from ku_art where shenhe=1 order by hits desc,ID desc"
	case 2 '新信息
InfoSql="select top "&nums&" * from ku_art where shenhe=1 order by AddDate desc,ID desc"
	case 3 '大类热门
InfoSql="select top "&nums&" * from ku_art where shenhe=1 and Sort1="&S_info&" order by hits desc,ID desc"
	case 4 '小类热门
InfoSql="select top "&nums&" * from ku_art where shenhe=1 and Sort2="&S_info&" order by hits desc,ID desc"
	case 5 '大类
InfoSql="select top "&nums&" * from ku_art where shenhe=1 and Sort1="&S_info&" order by AddDate desc,ID desc"
	case 6 '小类
InfoSql="select top "&nums&" * from ku_art where shenhe=1 and Sort2="&S_info&" order by AddDate desc,ID desc"
	Case 7 '推荐
InfoSql="select top "&nums&" * from ku_art Where shenhe=1 and Pw_Good=True ORDER BY id DESC"
	Case else  '其它
InfoSql="select top "&nums&" * from ku_art where shenhe=1 order by hits desc"
End Select

Set InfoRs=Conn.Execute(InfoSql)
if InfoRs.eof or InfoRs.bof then
response.write"<tr><td align='center'>没有信息...</td></tr>"
end if 
while not Infors.eof 
set title=Infors("title")
set id=Infors("id")
response.write "<tr><td width=""6%""align=""left"" height='25'><img src=""ku_skin/bz.gif""  align=""absmiddle"" height='12' width='12'></td><td width=""72%""><p style='line-height: 120%'>"& vbCrLf
response.write "<a href='Ku_showart.asp?id="&id&"'title='"&title&"'>"
if GetLen(title)>Linenum then
response.write ""&LeftStr(title,Linenum-2)&""
response.write "..."
else
response.write ""&title&""
end if
if Show_date=1 then 
response.write "&nbsp;&nbsp;"
response.write "</td><td>"
response.write "<font color='#808080'>"
response.write DateTimeFormat(Infors("AddDate"),4)
response.write "</font>"
End if
response.write "</a></td></tr>"
Infors.movenext  
wend
Infors.close
set Infors=nothing
response.write "</table>"
End Function
%>
<%
    '//文章信息调用
    Function ku_articleInfo(s_num,nums,Linenum,S_info,Show_date)
    response.write "<div align=center>"
    response.write "<table border=0 cellpadding=0 cellspacing=0 width=242 height=128 background=xbqq_img/kind3.gif>"
    response.write "<tr>"
    response.write "<td valign=top>"
    '------------主要内容开始
    response.write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""1"" cellspacing=""1"">"& vbCrLf
    Select case s_num
    case 1 '热门
    InfoSql="select top "&nums&" * from ku_art where shenhe=1 order by hits desc,ID desc"
    case 2 '新信息
    InfoSql="select top "&nums&" * from ku_art where shenhe=1 order by AddDate desc,ID desc"
    case 3 '大类热门
    InfoSql="select top "&nums&" * from ku_art where shenhe=1 and Sort1="&S_info&" order by hits desc,ID desc"
    case 4 '小类热门
    InfoSql="select top "&nums&" * from ku_art where shenhe=1 and Sort2="&S_info&" order by hits desc,ID desc"
    case 5 '大类
    InfoSql="select top "&nums&" * from ku_art where shenhe=1 and Sort1="&S_info&" order by AddDate desc,ID desc"
    case 6 '小类
    InfoSql="select top "&nums&" * from ku_art where shenhe=1 and Sort2="&S_info&" order by AddDate desc,ID desc"
    Case 7 '推荐
    InfoSql="select top "&nums&" * from ku_art Where shenhe=1 and Pw_Good=True ORDER BY id DESC"
    Case else  '其它
    InfoSql="select top "&nums&" * from ku_art where shenhe=1 order by hits desc"
    End Select
    Set InfoRs=Conn.Execute(InfoSql)
    if InfoRs.eof or InfoRs.bof then
    response.write"<tr><td align='center'>没有信息...</td></tr>"
    end if 
    while not Infors.eof 
    set title=Infors("title")
    set id=Infors("id")
    response.write "<tr><td width=""8%""align=""right"" height='24'><img src=""ku_skin/bz.gif"" width=""12"" height=""11"" align=""absmiddle""></td><td width=""92%""><p style='line-height: 150%'>"& vbCrLf
    response.write "<a href='Ku_showart.asp?id="&id&"'title='"&title&"'>"
    if GetLen(title)>Linenum then
    response.write ""&LeftStr(title,Linenum-2)&""
    response.write "..."
    else
    response.write ""&title&""
    end if
    if Show_date=1 then 
    response.write "&nbsp;&nbsp;"
    response.write DateTimeFormat(Infors("AddDate"),4)
    End if
    response.write "</a></td></tr>"
    Infors.movenext  
    wend
    Infors.close
    set Infors=nothing
    response.write "</table>"
    '-----------主要内容结束
    response.write "</td>"
    response.write "</tr>"
    response.write "</table>"
    response.write "</div>"


    End Function
%>
<%
    '//广告调用
    Function Ku_AD(AD_ID)
    set ADRS=server.createobject("adodb.recordset")
    sql="select top 1 AD_ID,AD_Title,AD_Http,AD_width,blank,AD_height,AD_Pic,AD_Note from ku_ad where AD_ID="&AD_ID&""
    ADRS.open sql,conn,1,1
    Pi_c=ADRS("Ad_pic")
    If ADRS.bof Then
    Response.write"没有广告"
    Else
    %>
		<%
			IF right(Pi_c,3)="swf" THEN
		%><p align="center">
		
		<OBJECT classid="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"
 codebase="http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0"
  WIDTH="<% =ADRS("AD_width") %>" HEIGHT="<% =ADRS("AD_height")%>" id="welcome" >
 <PARAM NAME=movie VALUE="<% =Pi_c %>"> 
 <PARAM NAME=quality VALUE=high>
 <EMBED src="<% =Pi_c %>" quality=high   WIDTH="<%=AD_width%>" HEIGHT="<%=AD_height%>" NAME="welcome" ALIGN="" TYPE="application/x-shockwave-flash" PLUGINSPAGE="http://www.macromedia.com/go/getflashplayer"></EMBED>
</OBJECT>
</p>

<%else%><%
    if ADRS("AD_http")="" then
    Response.Write("<div align=center>")
    Response.Write("<img src="&ADRS("Ad_Pic")&" width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&" border=""0""><div>")
    else
    if ADRS("blank")=true then
    Response.Write("<div align=center><a title='广告位招商!联系QQ:565505113' target='_blank' href="&ADRS("Ad_Http")&">")
    Response.Write("<img src="&ADRS("Ad_Pic")&" width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&" border=""0""></a><div>")
    else
    Response.Write("<div align=center><a title='广告位招商!联系QQ:565505113' href="&ADRS("Ad_Http")&">")
    Response.Write("<img src="&ADRS("Ad_Pic")&" width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&" border=""0""></a><div>")
    end if
    end if
    end if
    End If
    End Function
%>
<%
function gotTopic(str,strlen)
	if str="" then
		gotTopic=""
		exit function
	end if
	dim l,t,c, i
	str=replace(replace(replace(replace(str,"&nbsp;"," "),"&quot;",chr(34)),"&gt;",">"),"&lt;","<")
	l=len(str)
	t=0
	for i=1 to l
		c=Abs(Asc(Mid(str,i,1)))
		if c>255 then
			t=t+2
		else
			t=t+1
		end if
		if t>=strlen then
			gotTopic=left(str,i) & ".."
			exit for
		else
			gotTopic=str
		end if
	next
	gotTopic=replace(replace(replace(replace(gotTopic," ","&nbsp;"),chr(34),"&quot;"),">","&gt;"),"<","&lt;")
end function


Function FlashNews(num,fontnum,PicWidthStr,PicHeightStr,BGcolor,txtheight)
Dim RsFilterObj,FlashStr,ImagesStr,TxtStr,LinkStr
FilterSql = "SELECT top "&num&" * FROM Ku_news where pic is not null and shenhe=1 ORDER BY dateandtime DESC"
Set RsFilterObj = Conn.Execute(FilterSql)
If not RsFilterObj.Eof then
  Dim Temp_Num
  Temp_Num = 0
  Do While Not RsFilterObj.Eof
  Temp_Num = Temp_Num + 1
  RsFilterObj.MoveNext
  Loop
  RsFilterObj.MoveFirst
  If Temp_Num <=1 then
  Set RsFilterObj = Nothing
  FlashNews = "至少需要两条幻灯新闻才能正确显示幻灯效果"
  Set RsFilterObj = Nothing
  Exit Function 
  End If
  do while Not RsFilterObj.Eof
   if ImagesStr = "" then
     ImagesStr = RsFilterObj("pic")
     TxtStr = gotTopic(RsFilterObj("Title"),fontnum)
     LinkStr = "Ku_shownews.asp?id="&RsFilterObj("id")
   else
     ImagesStr = ImagesStr &"|"& RsFilterObj("pic")
     TxtStr = TxtStr & "|" & gotTopic(RsFilterObj("title"),fontnum)
     LinkStr = LinkStr & "|" & "Ku_shownews.asp?id="& RsFilterObj("id")
   end if
  RsFilterObj.MoveNext
  loop
FlashStr="<script type=""text/javascript"">"& Chr(13)
FlashStr=FlashStr&"<!--"& Chr(13)
FlashStr=FlashStr&"var focus_width="&PicWidthStr& Chr(13)   
FlashStr=FlashStr&"var focus_height="&PicHeightStr& Chr(13) 
FlashStr=FlashStr&"var text_height="&txtheight& Chr(13) 
FlashStr=FlashStr&"var swf_height = focus_height+text_height"& Chr(13)
FlashStr=FlashStr&"var pics='"&ImagesStr&"'"&Chr(13)
FlashStr=FlashStr&"var links='"&LinkStr &"'"&Chr(13)
FlashStr=FlashStr&"var texts='"&TxtStr&"'"&Chr(13)
FlashStr=FlashStr&"document.write('<object classid=""clsid:d27cdb6e-ae6d-11cf-96b8-444553540000"" codebase=""http://fpdownload.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0"" width=""'+ focus_width +'"" height=""'+ swf_height +'"">');"&Chr(13)
FlashStr=FlashStr&"document.write('<param name=""allowScriptAccess"" value=""sameDomain""><param name=""movie"" value=""ku_skin/pic.swf""><param name=""quality"" value=""high""><param name=""bgcolor"" value="&BGcolor&">');"&Chr(13)
FlashStr=FlashStr&"document.write('<param name=""menu"" value=""false""><param name=wmode value=""opaque"">');"&Chr(13)
FlashStr=FlashStr&" document.write('<param name=""FlashVars"" value=""pics='+pics+'&links='+links+'&texts='+texts+'&borderwidth='+focus_width+'&borderheight='+focus_height+'&textheight='+text_height+'"">');"&Chr(13)
FlashStr=FlashStr&"document.write('<embed src=""ku_skin/pic.swf"" wmode=""opaque"" FlashVars=""pics='+pics+'&links='+links+'&texts='+texts+'&borderwidth='+focus_width+'&borderheight='+focus_height+'&textheight='+text_height+'"" menu=""false"" bgcolor="&BGcolor&" quality=""high"" width=""'+ focus_width +'"" height=""'+ swf_height +'"" allowScriptAccess=""sameDomain"" type=""application/x-shockwave-flash"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" />');"&Chr(13)
FlashStr=FlashStr&"document.write('</object>');"&Chr(13)
FlashStr=FlashStr&"//-->"& Chr(13)
FlashStr=FlashStr&"</script>"
  else
    FlashStr="没有幻灯图片"
  end if
    RsFilterObj.Close
Set RsFilterObj = Nothing
    FlashNews= FlashStr
End Function
%>
<%



function DateTimeFormat(DateTime,Format) 
select case Format
case "1"
 DateTimeFormat=""&year(DateTime)&"年"&month(DateTime)&"月"&day(DateTime)&"日"
case "2"
 DateTimeFormat=""&month(DateTime)&"月"&day(DateTime)&"日"
case "3" 
 DateTimeFormat=""&year(DateTime)&"-"&month(DateTime)&"-"&day(DateTime)&""
case "4" 
 DateTimeFormat=""&year(DateTime)&"/"&month(DateTime)&"/"&day(DateTime)&""
case "5"
 DateTimeFormat=""&month(DateTime)&"/"&day(DateTime)&""
case "8"
 DateTimeFormat=""&month(DateTime)&"-"&day(DateTime)&"<font color=red> "&FormatDateTime(DateTime,4)&"</font>"
case "6"
 DateTimeFormat=""&year(DateTime)&"年"&month(DateTime)&"月"&day(DateTime)&"日<font color=red> "&FormatDateTime(DateTime,4)&"</font>"
case "7"
   temp="星期日,星期一,星期二,星期三,星期四,星期五,星期六"
   temp=split(temp,",") 
   DateTimeFormat=temp(Weekday(DateTime)-1)
case else
 DateTimeFormat=DateTime
end select
end function

%>



<%
    Function GetLen(str)
    Dim l, t, c, i
    l = Len(str)
    t = l
    For i = 1 To l
    c = Asc(Mid(str, i, 1))
    If c < 0 Then c = c + 65536
    If c > 255 Then t = t + 1
    Next
    GetLen = t
    End Function
%>
<%
    Function isInt(str)
    Dim L,I
    isInt=False
    If Trim(Str)="" Or IsNull(str) Then Exit Function
    str=CStr(Trim(str))
    L=Len(Str) 
    For I=1 To L
    If Mid(Str,I,1)>"9" Or Mid(Str,I,1)<"0" Then Exit Function
    Next 
    isInt=True
    End Function
%>
<%
    Function LeftStr(text,length)  
    Dim t
    t=""
    Dim mt
    Dim l
    l=0
    Dim c
    For i= 1 To Len(text)
    mt=mid(text,i,1)
    c=Asc(mt)
    If c<0 Then c=c+65536
    If c > 255 Then
    l=l+2
    Else 
    l=l+1
    End If
    If l<=CLng(length) Then
    t=t&mt
    else
    exit for
    End If
    Next
    LeftStr=t
    End Function
%>
<%
    Function CheckStr(Str) 
    If Trim(Str)="" Or IsNull(str) Then Exit Function
    Checkstr=Replace(Trim(Str),"'","''")
    End Function
%>